home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
lisp
/
eulisp
/
feel-075.lha
/
feel0.75
/
Src
/
structs.h
< prev
next >
Wrap
C/C++ Source or Header
|
1992-06-18
|
15KB
|
602 lines
/* ******************************************************************** */
/* structs.h Copyright (C) Codemist and University of Bath 1989 */
/* */
/* Basic definitions of tags and structures */
/* ******************************************************************** */
/*
* Change Log:
* Version 1, April 1989
* added a little support for classes RJB
* hacked it about a bit KJP
* added semaphores KJP
*/
#ifndef STRUCTS_H
#define STRUCTS_H
#include <stdio.h>
#ifdef WITH_BIGNUMS
#include "BigZ.h"
#endif
#undef BIGNUM
#ifndef SETJMP_H
#define SETJMP_H
#include <setjmp.h>
#endif
/* Load system types... */
#include "system_t.h"
/*#include "compact.h"*/
/* Primitive types... */
/* indiacte that ob can be swept */
/* note that the bignum typeof operation may need to be changed
plus some comparisons in arith.c --- unless we do them right
--- pab */
#define CALLABLE_TYPE 0x100
#define MACRO_TYPE 0x200
#define STATIC_TYPE 0x400
#define TYPE_UNUSED -1
#define TYPE_ENV 0xe0
#define TYPE_CONS 0x1
#define TYPE_CHAR (0x2)
#define TYPE_STRING (0x3)
#define TYPE_TABLE (0x5)
#define TYPE_SYMBOL (0x6)
#define TYPE_THREAD (0xb)
#define TYPE_STREAM (0xc)
#define TYPE_CLASS (0xd)
#define TYPE_INSTANCE (0xe)
#define TYPE_SPECIAL (0xf)
#define TYPE_VECTOR 0x10
#define TYPE_INT (0x11)
#define TYPE_RATIONAL (0x14)
#define TYPE_FLOAT (0x15)
#define TYPE_COMPLEX (0x16)
#define TYPE_BIGNUM (0x17)
#define TYPE_LASTNUMBER 0x2f
#define TYPE_CONTINUE (0x30)
#define TYPE_C_MODULE (0x40)
#define TYPE_I_MODULE (0x50)
#define TYPE_C_FUNCTION (0x60 | 0x100)
#define TYPE_I_FUNCTION (0x61 | 0x100)
#define TYPE_METHOD 0x62
#define TYPE_GENERIC (0x63 | 0x100)
#define TYPE_C_MACRO (0x70 | 0x200)
#define TYPE_I_MACRO (0x71 | 0x200)
#define TYPE_SEMAPHORE (0x90)
#define TYPE_LISTENER (0xa0)
#define TYPE_SOCKET (0xa1)
#define TYPE_NULL (0xb0)
#define TYPE_WEAK_WRAPPER 0xc0
#define TYPE_B_FUNCTION (0x7a | 0x100)
#define TYPE_B_MACRO (0x7b | 0x200)
/* Primitive accessors... */
#ifdef NOLOWTAGINTS
#define typeof(p) ((p)->OBJECT.header.type)
#define classof(p) ((p)->OBJECT.header.class)
#else
#define typeof(p) (((int)p) & 1 ? TYPE_INT: ((p)->OBJECT.header.type))
#define classof(p) (((int)p) & 1 ? Integer: ((p)->OBJECT.header.class))
#endif
#define type_of(p) typeof(p)
#define gcof(p) (((p)->OBJECT).header.gc)
#define gc_of(p) gcof(p)
#define lval_classof(p) ((p)->OBJECT.header.class)
#define lval_typeof(p) ((p)->OBJECT.header.type)
#define class_of(p) classof(p)
/* Primitive type testers... */
#define is_cons(p) (typeof(p) == TYPE_CONS)
#define is_char(p) (typeof(p) == TYPE_CHAR)
#define is_string(p) (typeof(p) == TYPE_STRING)
#define is_table(p) (typeof(p) == TYPE_TABLE)
#define is_symbol(p) (typeof(p) == TYPE_SYMBOL)
#define is_function(p) (typeof(p) & CALLABLE_TYPE)
#define is_macro(p) (typeof(p) & MACRO_TYPE)
#define is_static(p) (typeof(p) & STATIC_TYPE)
#define is_module(p) ((typeof(p) == TYPE_I_MODULE) | \
(typeof(p) == TYPE_C_MODULE))
#define is_special(p) (typeof(p) == TYPE_SPECIAL)
#define is_thread(p) (typeof(p) == TYPE_THREAD)
#define is_stream(p) (typeof(p) == TYPE_STREAM)
#ifdef NOLOWTAGINTS
#define is_fixnum(p) (typeof(p) == TYPE_INT)
#else
#define is_fixnum(p) (((int) (p)) &1)
#define mk_fixnum(x) ((LispObject) (((x)<<1) | 1))
#endif
#define is_bignum(p) (typeof(p) == TYPE_BIGNUM)
#define is_float(p) (typeof(p) == TYPE_FLOAT)
#define is_vector(p) ((typeof(p)&TYPE_VECTOR) == TYPE_VECTOR)
#define is_continue(p) (typeof(p) == TYPE_CONTINUE)
#define is_c_function(p) (typeof(p) == TYPE_C_FUNCTION)
#define is_c_module(p) (typeof(p) == TYPE_C_MODULE)
#define is_i_function(p) (typeof(p) == TYPE_I_FUNCTION)
#define is_i_module(p) (typeof(p) == TYPE_I_MODULE)
#define is_c_macro(p) (typeof(p) == TYPE_C_MACRO)
#define is_i_macro(p) (typeof(p) == TYPE_I_MACRO)
#define is_b_function(p) (typeof(p)==TYPE_B_FUNCTION)
#define is_b_macro(p) (typeof(p) == TYPE_B_MACRO)
#define is_semaphore(p) (typeof(p) == TYPE_SEMAPHORE)
#define is_listener(p) (typeof(p) == TYPE_LISTENER)
#define is_socket(p) (typeof(p) == TYPE_SOCKET)
#define is_weak_wrapper(p) (typeof(p) == TYPE_WEAK_WRAPPER)
#define is_e_function(p) (0)
#define is_e_macro(p) (0)
/* Other macros... */
#define null(p) ((LispObject)(p) == nil)
#define consp(p) (is_cons(p) && (p) != nil)
#define symbolp(p) (is_symbol(p) || (p) == nil)
#define CAR(p) (((p)->CONS).car)
#define CDR(p) (((p)->CONS).cdr)
#define classp(p) (typeof(p) & 0x2000)
#define is_number(p) (typeof(p) >= TYPE_INT && typeof(p) <= TYPE_LASTNUMBER)
typedef union lispunion *LispObject;
/* GC used object... */
struct hunk_structure {
short type;
short gc;
LispObject next_hunk;
int hunk_size;
};
typedef struct Object_struct
{
short type;
short gc;
LispObject class;
} Object_t;
struct envobject {
Object_t header;
LispObject variable;
LispObject value;
struct envobject * next;
LispObject mutable;
};
typedef struct envobject *Env;
/* the top most class object */
struct object_structure {
Object_t header;
LispObject slots[1]; /* the other slots */
};
struct integer_structure {
Object_t header;
int value_part;
};
#ifdef NOLOWTAGINTS
#define intval(x) ((x)->INT.value_part)
#else
#define intval(x) (((int)x)>>1)
#endif
/* low tag ints */
struct float_structure {
Object_t header;
double fvalue;
};
struct bignum_structure {
Object_t header;
#ifdef WITH_BIGNUMS
BigZ value;
#endif
int * bnum;
};
struct complex_structure {
Object_t header;
LispObject real;
LispObject imaginary;
};
struct ratio_structure {
Object_t header;
LispObject numerator;
LispObject denominator;
};
struct character_structure {
Object_t header;
unsigned char font;
unsigned char code;
};
struct symbol_structure {
Object_t header;
int hash; /* hash value cache */
LispObject lmodule; /* Module lookup cache for the interpreter */
LispObject lvalue; /* Part II */
LispObject gvalue; /* Dynamic global value */
LispObject plist;
LispObject pname;
LispObject left;
LispObject right;
};
/* comparator is a equality function, defaulting to Fn_equal,
* returning t or nil.
*/
struct table_structure {
Object_t header;
LispObject (*comparator)(LispObject*);
LispObject lisp_comparator;
LispObject tree;
};
/* This one is an internal type, used by tables and arrays.
* "base" is the first element in the array -- the others follow
* on directly --- note that this comment is carp (anag)
*/
#ifdef notdef /* Thu Oct 17 14:49:31 1991 */
/**/
/**/#define vref(v,n) (*((v)->VECTOR.base + (n)))
/**/#define vrefupdate(v,n,obj) (vref(v,n)=obj)
#endif /* notdef Thu Oct 17 14:49:31 1991 */
#define vref(v,n) (*(&((v)->VECTOR.base) + (n)))
#define vrefupdate(v,n,obj) (vref(v,n)=(obj))
struct vector_structure {
Object_t header;
int length; /* for now */
LispObject base;
};
#ifdef WITH_SMALL_CONSES
struct cons_structure {
short type;
short gc;
LispObject car;
LispObject cdr;
};
#else
struct cons_structure {
Object_t header;
LispObject car;
LispObject cdr;
};
#endif
struct stream_structure {
Object_t header;
FILE* handle;
LispObject name;
int curchar;
int mode;
};
struct string_structure {
Object_t header;
int length;
char value; /* really a c-string --- Should these be CHARs ?? */
};
#define stringof(x)\
(&((x)->STRING.value))
struct funcallable_object_structure {
Object_t header;
LispObject (*cfun)();
LispObject cfun_arg;
};
struct continue_structure {
Object_t header;
LispObject value; /* Returned with... */
LispObject target; /* When bouncing unwind protects... */
LispObject thread;
LispObject *gc_stack_pointer; /* Interpreter state */
Env dynamic_env;
LispObject last_continue;
LispObject handler_stack;
LispObject dp; /* Elvira state */
/* Bytecode state? */
jmp_buf machine_state;
int live;
int unwind;
};
struct thread_structure {
Object_t header;
LispObject* gc_stack_base;
LispObject state;
LispObject fun;
LispObject args;
LispObject value;
LispObject parent;
LispObject cochain;
int status;
int stack_size;
int gc_stack_size;
int* stack_base;
};
struct semaphore_structure {
Object_t header;
SystemSemaphore semaphore; /* Just a hacked wrapper */
};
struct class_structure {
Object_t header;
int local_count; /* Number of local slots */
LispObject name; /* Name of the class (NOT binding name) */
LispObject superclasses; /* Direct parents */
LispObject subclasses; /* Direct subclasses */
LispObject slot_table; /* Table of slot descriptions */
LispObject slot_list; /* Slot list */
LispObject direct_slot_list; /* Direct slot list */
LispObject precedence; /* Class precedence list */
#ifdef notdef /* Thu Oct 17 14:50:09 1991 */
/**/ LispObject prototype; /* Prototypical instance */ *
#endif /* notdef Thu Oct 17 14:50:09 1991 */
};
#define slotref(v,n) (*(&((v)->INSTANCE.slots) + (n)))
#define slotrefupdate(v,n,obj) (slotref(v,n)=obj)
struct instance_structure {
Object_t header;
LispObject slots; /* Some structure of data */
};
/* Functions... */
/* Special forms are compiler only and don't have homes (?) */
struct special_structure {
Object_t header;
LispObject name;
Env env;
LispObject (*func)();
};
/* Basic function template to which all conform */
struct function_structure {
Object_t header;
LispObject name; /* Original name in their module of origin */
LispObject home; /* Module of origin */
Env env; /* Defining parameter environment */
int argtype; /* Argument type code - unique for args */
};
struct c_function_structure {
Object_t header;
LispObject name;
LispObject home;
Env env;
int argtype;
LispObject (*func)(); /* Compiled functions just need fun pointer */
};
struct i_function_structure {
Object_t header;
LispObject name;
LispObject home;
Env env;
int argtype;
LispObject bvl; /* Parameter list */
LispObject body; /* Body forms */
};
/* Macros are a logical entity - being just specially interpretted functions */
struct generic_structure {
Object_t header;
LispObject name;
LispObject home;
Env env; /* Redundant, I think */
int argtype;
LispObject method_class;
LispObject discriminator;
LispObject cache_table;
LispObject method_table; /* Like it says */
};
/* Methods AREN'T FUNCTIONS ! */
struct method_structure {
Object_t header;
LispObject qualifier; /* Whatever that may be */
LispObject signature; /* Class list up to any n-ary bit */
LispObject host; /* Generic function ( nil => unatached ) */
LispObject function; /* The actual function */
LispObject fixed; /* Detatchable or not */
};
/* Module structures */
/* Template for all types - an abstract class like function */
struct module_structure {
Object_t header;
LispObject name; /* Symbol */
LispObject home; /* In ? */
LispObject imported_modules; /* Module dependecies - name list */
LispObject exported_names; /* Name list too */
LispObject bindings;
};
struct c_module_structure {
Object_t header;
LispObject name;
LispObject home;
LispObject imported_modules;
LispObject exported_names;
LispObject bindings;
LispObject values; /* Value vector of static module */
LispObject entry_count;
LispObject (**functions)(); /* Function vector */
};
typedef struct c_module_structure MODULE;
struct i_module_structure {
Object_t header;
LispObject name;
LispObject home;
LispObject imported_modules;
LispObject exported_names;
LispObject bindings;
int bounce_flag;
};
/* Sockets support... */
#if (defined(WITH_BSD_SOCKETS) || defined(WITH_SYSTEMV_SOCKETS))
#include "syssockets.h"
struct listener_structure {
Object_t header;
SocketHandle socket;
SocketInName name;
int state;
};
struct socket_structure {
Object_t header;
SocketHandle socket;
SocketInName name;
char buffer[SOCKET_BUFFER_SIZE]; /* Input buffer */
int state;
};
#endif
/* Structure for extensiblility without hacking... */
struct c_object_structure {
Object_t header;
LispObject *slots; /* LispObject slot vector - garbage protected */
char first_c_byte; /* Start of C-data, unprotected */
};
/* Weak wrappers... */
struct weak_wrapper_structure {
Object_t header;
LispObject object;
};
union lispunion {
struct hunk_structure HUNK;
struct object_structure OBJECT;
struct integer_structure INT;
struct float_structure FLOAT;
struct bignum_structure BIGNUM;
struct complex_structure COMPLEX;
struct ratio_structure RATIO;
struct character_structure CHAR;
struct symbol_structure SYMBOL;
struct table_structure TABLE;
struct cons_structure CONS;
struct stream_structure STREAM;
struct string_structure STRING;
struct thread_structure THREAD;
struct semaphore_structure SEMAPHORE;
struct class_structure CLASS;
struct instance_structure INSTANCE;
struct vector_structure VECTOR;
struct continue_structure CONTINUE;
struct envobject ENV;
struct special_structure SPECIAL;
struct function_structure FUNCTION;
struct c_function_structure C_FUNCTION;
struct i_function_structure I_FUNCTION;
/** struct generic_structure GENERIC; */
struct function_structure MACRO;
struct c_function_structure C_MACRO;
struct i_function_structure I_MACRO;
/** struct method_structure METHOD; */
struct module_structure MODULE;
struct c_module_structure C_MODULE;
struct i_module_structure I_MODULE;
#if (defined(WITH_BSD_SOCKETS) || defined(WITH_SYSTEMV_SOCKETS))
struct listener_structure LISTENER;
struct socket_structure SOCKET;
#endif
struct c_object_structure C_OBJECT;
struct weak_wrapper_structure WEAK_WRAPPER;
};
#include "system_p.h"
#endif /* STRUCTS_H */
/* End of structs.h */